<%
'''Cookie操作类,如果使用了加密应引入("ClassAes.class.asp")
'''todo ClassAes.class.asp有问题，暂时不启用
Class AshapoCookie
	
	Private	s_expires, s_domain, s_path, s_prefix, s_secure, s_httponly, s_aesEncode, s_aesKey

	Private s_aes

	'''构造
	Private Sub Class_Initialize()
		s_expires = 0
		s_domain = ""
		s_path = "/"
		s_prefix = ""
		s_secure = False
		s_httponly = False
		s_aesEncode = False
		s_aesKey = ""
	End Sub

	'''析构
	Private Sub Class_Terminate()
		If Has(s_aes) Then
			Set s_aes = Nothing
		End If
	End Sub

	'''设置Cookie过期时间
	'p_expires: 过期时间，如果是时间类型，则到指定时间后失效，如果是数字，则为当前时间后指定时长(单位秒)失效，特殊值0表示永久有效，-1表示退出后失效
	Public Property Let Expires(Byval p_expires)
		s_expires = p_expires
	End Property

	'''设置Cookie有效域名
	'p_domain: 域名
	Public Property Let Domain(ByVal p_domain)
		s_domain = p_domain
	End Property

	'''指定Cookie有效路径
	'p_path:路径
	Public Property Let Path(Byval p_path)
		s_path = p_path
	End Property

	'''指定Cookie前缀
	'p_prefix:Cookie前缀
	Public Property Let Prefix(Byval p_prefix)
		s_prefix = p_prefix
	End Property

	'''指定是否只允许HTTPS
	'p_secure:只允许HTTPS
	Public Property Let Secure(Byval p_secure)
		s_secure = p_secure
	End Property

	'''指定是否不允许JS读取Cookie
	'p_httponly:不允许JS读取Cookie
	Public Property Let HttpOnly(Byval p_httponly)
		s_httponly = p_httponly
	End Property

	'''指定是否对Cookie进行加密
	'''如果使用了加密应引入("ClassAes.class.asp")
	'p_aesEncode:对Cookie进行加密
	Public Property Let AesEncode(Byval p_aesEncode)
		s_aesEncode = p_aesEncode
		If p_aesEncode Then
			Set s_aes = New ClassAes
		End If
	End Property

	'''指定Cookie的AES加解密密钥
	'p_aesKey:AES加解密密钥
	Public Property Let AesKey(Byval p_aesKey)
		s_aesKey = p_aesKey
	End Property

	'''取Cookie值(默认)
	'p_key: String cookie键值
    Public Default Property Get Value(Byval p_key)
		If s_aesEncode Then
			s_aes.Password = s_aesKey
		End If
		If Request.Cookies(s_prefix & p_key).HasKeys Then
			Dim t_key_y, t_arr : Set t_arr = Sa.Dictionary
			'''todo 目前仅支持2层内cookie
			For Each t_key_y In Request.Cookies(s_prefix & p_key)
				If s_aesEncode Then
					t_arr(t_key_y) = s_aes.Decode(Request.Cookies(s_prefix & p_key)(t_key_y))
				Else
					t_arr(t_key_y) = Request.Cookies(s_prefix & p_key)(t_key_y)
				End If
		    next
			Set Value = t_arr
			'Set t_arr = Nothing
		Else
			If s_aesEncode Then
				Value = s_aes.Decode(Request.Cookies(s_prefix & p_key))
			Else
				Value = Request.Cookies(s_prefix & p_key)
			End If
		End If
    End Property

	'''设置Cookie值
	'p_key:不含前缀的Cookie键名
	'p_val:Cookie值
	Public Property Let Value(Byval p_key, Byval p_val)
		If s_aesEncode Then
			s_aes.Password = s_aesKey
			p_val = s_aes.Encode(p_val)
		End If
        Response.Cookies(s_prefix & p_key) = p_val
		If Cstr(s_expires) <> "-1" Then
			If Cstr(s_expires) = "0" Then
				'''永久有效(其实是1年)
				Response.Cookies(s_prefix & p_key).Expires = DateAdd("yyyy", 1, now())
			Else
				If IsNumeric(s_expires) Then
					Response.Cookies(s_prefix & p_key).Expires = DateAdd("s", Cint(s_expires), now())
				Else
					Response.Cookies(s_prefix & p_key).Expires = s_expires
				End If
			End If
		End If
		'''todo:以下3个属性在IE下设置尚有问题待解决
		'Response.Cookies(s_prefix & p_key).Domain = s_domain
		'Response.Cookies(s_prefix & p_key).Path = s_path
		'Response.Cookies(s_prefix & p_key).Secure = s_secure
		
		'''todo 待修改
		'''Response.Cookies不支持直接HttpOnly
		'Response.Cookies(s_prefix & p_key).HttpOnly = s_httponly
	End Property

	'''设置Cookie组值
	'p_key:不含前缀的Cookie键名
	'p_val:Cookie值(字典键值对)
	Public Property Set Value(Byval p_key, Byval p_val)
		If s_aesEncode Then
			s_aes.Password = s_aesKey
		End If
		Dim t_key_y
		For Each t_key_y In p_val
			If Not IsNull( p_val(t_key_y) ) Then
				If IsObject( p_val(t_key_y) ) Then
					Die("无法在cookie中存放对象")
				End If
				If s_aesEncode Then
					Response.Cookies(s_prefix & p_key)(t_key_y) = s_aes.Encode(p_val(t_key_y))
				Else
					Response.Cookies(s_prefix & p_key)(t_key_y) = p_val(t_key_y)
				End If
			Else
				'''todo NULL值是否要写入COOKIE空值？
				Die("何必写入空的cookie？")
				Response.Cookies(s_prefix & p_key)(t_key_y) = ""
			End If
		Next
		If Cstr(s_expires) <> "-1" Then
			'Response.Write("设置了有效时间")
			If Cstr(s_expires) = "0" Then
				'''永久有效(其实是1年)
				Response.Cookies(s_prefix & p_key).Expires = DateAdd("yyyy", 1, now()) 
			Else
				If IsNumeric(s_expires) Then
					Response.Cookies(s_prefix & p_key).Expires = DateAdd("s", Cint(s_expires), now())
				Else
					Response.Cookies(s_prefix & p_key).Expires = s_expires
				End If
			End If
		End If
		'''todo:以下3个属性在IE下设置尚有问题待解决
		'Response.Cookies(s_prefix & p_key).Domain = s_domain
		'Response.Cookies(s_prefix & p_key).Path = s_path
		'Response.Cookies(s_prefix & p_key).Secure = s_secure
		'''todo 待修改
		'''Response.Cookies不支持直接HttpOnly
		'Response.Cookies(s_prefix & p_key).HttpOnly = s_httponly
	End Property

	'''删除某个Cookie值
	'p_key: String (字符串)cookie键值
	Public Sub [Remove](Byval p_key)
		Response.Cookies(s_prefix & p_key) = Empty
		Response.Cookies(s_prefix & p_key).Expires = FormatDateTime(Now()-1)
    End Sub

	'''清空删除所有Cookie值
	Public Sub [RemoveAll]()
		Dim t_c,t_sk
		For Each t_c In Request.Cookies
			If Not(Request.Cookies(t_c).HasKeys) Then
				Response.Cookies(t_c) = Empty
			Else
				For Each t_sk In Request.Cookies(t_c)
					Response.Cookies(t_c)(t_sk) = Empty
				Next
			End if
			Response.Cookies(t_c).Expires = FormatDateTime(Now()-1)
		Next
	End Sub
End Class
%>